MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 07 - 1991/07.10 Oct 91/Window Menubar Source ƒ/wBMMiscSubs.p

Text File | 1991-07-25 | 12.0 KB | 566 lines | [TEXT/PJMM]

{ ******************************************************** }
{ "wBMMiscSubs.p"                                          }
{                                                          }
{ by John A. Love, III [ Washington Apple Pi Users' Group] }
{                                                          }
{ using Symantec's "THINK Lightspeed Pascal", v 3.02       }
{                                                          }
{ ******************************************************** }


UNIT wBMMiscSubs;

INTERFACE

    USES
        Types, Quickdraw, Menus, TextEdit, Traps, Sound, wBMGlobals;


    PROCEDURE InitManagers;
    FUNCTION TestForColor (VAR pixelDepth: INTEGER): BOOLEAN;
    PROCEDURE LocalGlobal (VAR r: Rect);
    PROCEDURE GlobalLocal (VAR r: Rect);
    FUNCTION TrapAvailable (theTrap: INTEGER): BOOLEAN;
    FUNCTION WNEisImplemented: BOOLEAN;
    PROCEDURE PlaySound (mySound: Str255);
    FUNCTION GetStripAddressMask: LONGINT;
    FUNCTION QuickStrip (myPtr: Ptr): Ptr;
    FUNCTION GetMouseMovement (gMouse0: Point): Size;
    FUNCTION DoubleClick: BOOLEAN;
    PROCEDURE DimRgn (rgn: RgnHandle);
    FUNCTION Max (a, b: INTEGER): INTEGER;
    FUNCTION Min (a, b: INTEGER): INTEGER;
    FUNCTION GetWindowPartColor (window: WindowPtr; part: INTEGER; VAR color: RGBColor): BOOLEAN;
    PROCEDURE InitBigScreen (VAR RadStatus: RadiusData; VAR fontSize: INTEGER);
    PROCEDURE myTextSize (size: INTEGER);
    FUNCTION xPOWERy (x, y: INTEGER): extended;




IMPLEMENTATION




{ ==================================== }
{ No further explanation is required : }
{ ==================================== }

    PROCEDURE FatalSystemCrash;

    BEGIN
        ExitToShell;
    END;   { FatalSystemCrash }



    PROCEDURE MyMoreMasters (numMasterPtrs: INTEGER);
{ See Technical Note #53: }

        VAR
            oldMoreMast: INTEGER;
            zone: THz;

    BEGIN

        zone := GetZone;
        WITH zone^ DO
        BEGIN
            oldMoreMast := moreMast;
            moreMast := numMasterPtrs;
            MoreMasters;                 { Calls itself "moreMast" times. }
            moreMast := oldMoreMast;
            IF MemError <> noErr THEN
                ExitToShell;
        END;   { WITH }

    END;   { MyMoreMasters }



    PROCEDURE InitManagers;

    BEGIN

        MaxApplZone;
        MyMoreMasters(15);
        InitGraf(@thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(@FatalSystemCrash);
        ;
        FlushEvents(everyEvent, 0);
        InitCursor;

    END;   { InitManagers }



{ ================================================================================ }
{ Test for the presence of a Mac with Color QuickDraw and a Color Monitor that the }
{ user has set to Color via the Control Panel or using the "Switch-A-Roo" FKEY.    }
{                                                                                  }
{ Return the color depth:                                                          }
{ ================================================================================ }

    FUNCTION TestForColor (VAR pixelDepth: INTEGER): BOOLEAN;

        VAR
            theWorld: SysEnvRec;
            whoCares: OSErr;          { Compiler's "glue" for _SysEnvirons fills-in }
                                { all fields EXCEPT .systemVersion.           }

    BEGIN

        whoCares := SysEnvirons(SysEnvironsVersion, theWorld);
        IF theWorld.hasColorQD THEN
        BEGIN
            TestForColor := TRUE;
            pixelDepth := GetGDevice^^.gdPMap^^.pixelSize;
        END
        ELSE
        BEGIN
            TestForColor := FALSE;
            pixelDepth := 1;
        END;

    END;  { TestForColor }



{ =================== }
{ A short-cut or two: }
{ =================== }

    PROCEDURE LocalGlobal (VAR r: Rect);

    BEGIN

        WITH r DO
        BEGIN
            LocalToGlobal(topLeft);
            LocalToGlobal(botRight);
        END;

    END;   { LocalGlobal }



    PROCEDURE GlobalLocal (VAR r: Rect);

    BEGIN

        WITH r DO
        BEGIN
            GlobalToLocal(topLeft);
            GlobalToLocal(botRight);
        END;

    END;   { GlobalLocal }



{ ==================================== }
{ Common to the routines that follow:  }
{ Reference: IM, Volume VI, Chapter 3: }
{ ==================================== }

    FUNCTION GetTrapType (theTrap: INTEGER): TrapType;

        CONST
            TrapMask = $0800;               { Tests Bit #11. }

    BEGIN
        IF BAND(theTrap, TrapMask) > 0 THEN
            GetTrapType := ToolTrap
        ELSE
            GetTrapType := OSTrap;
    END;   { GetTrapType }



    FUNCTION GetTrapNum (theTrap: INTEGER): INTEGER;

        CONST
            ToolMask = $01FF;
            OSMask = $00FF;

    BEGIN
        IF GetTrapType(theTrap) = ToolTrap THEN
            GetTrapNum := BAND(theTrap, ToolMask)
        ELSE
            GetTrapNum := BAND(theTrap, OSMask);
    END;   { GetTrapNum }



    FUNCTION NumToolboxTraps: INTEGER;

        CONST
            _InitGraf = $A86E;
            _Magic = $AA6E;

    BEGIN
        IF NGetTrapAddress(GetTrapNum(_InitGraf), GetTrapType(_InitGraf)) = NGetTrapAddress(GetTrapNum(_Magic), GetTrapType(_Magic)) THEN
            NumToolboxTraps := $200
        ELSE
            NumToolboxTraps := $400;
    END;   { NumToolboxTraps }



    FUNCTION TrapAvailable (theTrap: INTEGER): BOOLEAN;

        VAR
            trapNum, tempINT: INTEGER;
            tType: TrapType;

    BEGIN

        trapNum := GetTrapNum(theTrap);
        tType := GetTrapType(theTrap);

        IF tType = ToolTrap THEN
        BEGIN
            tempINT := BXOR(theTrap, $A800);
            IF tempINT >= NumToolboxTraps THEN
                trapNum := GetTrapNum(_Unimplemented);
        END;   { a ToolTrap }

        TrapAvailable := NGetTrapAddress(trapNum, tType) <> NGetTrapAddress(GetTrapNum(_Unimplemented), GetTrapType(_Unimplemented));

    END;  { TrapAvailable }



{ ============================================== }
{ Now, let's put this new fangled stuff to work: }
{ ============================================== }

    FUNCTION WNEisImplemented: BOOLEAN;

    BEGIN

        WNEisImplemented := TrapAvailable(_WaitNextEvent);

    END;  { WNEisImplemented }



{ =============== }
{ Play it, Sam !! }
{ =============== }

    PROCEDURE PlaySound (mySound: Str255);

        VAR
            sndHandle: Handle;
            discardError: OSErr;

    BEGIN

        IF TrapAvailable(_SndPlay) THEN
        BEGIN
            sndHandle := GetNamedResource('snd ', mySound);
            IF sndHandle <> NIL THEN
            BEGIN
                discardError := SndPlay(NIL, sndHandle, FALSE);
                ReleaseResource(sndHandle);
            END;
        END;   { _SndPlay is implemented }

    END;  { PlaySound }



    FUNCTION GetStripAddressMask: LONGINT;
{ Adapted from Macintosh Tech Note #213 }

        CONST
            gLo3Bytes = $00FFFFFF;
            _StripAddress = $A055;

        VAR
            localBiggee: LONGINT;


    BEGIN

        IF TrapAvailable(_StripAddress) THEN
        BEGIN
            localBiggee := $FFFFFFFF;
            GetStripAddressMask := LONGINT(StripAddress(Ptr(localBiggee)));
        END
        ELSE
            GetStripAddressMask := gLo3Bytes;

    END;  { GetStripAddressMask }



    FUNCTION QuickStrip (myPtr: Ptr): Ptr;

    BEGIN
        QuickStrip := Ptr(BAND(ORD4(myPtr), gStripAddressMask));
    END;   { QuickStrip }



{ ======================================================= }
{ Returns vertical movement in High word and horizontal   }
{ movement in low word, similar to _GrowWindow.           }
{                                                         }
{ Note that the input Point is in GLOBAL coordinates.     }
{ Otherwise, dragging a window will return zero movement. }
{ ======================================================= }

    FUNCTION GetMouseMovement (gMouse0: Point): Size;

        VAR
            mouseLoc: Point;
            mouseDH, mouseDV: INTEGER;
            sizeMove: Size;

    BEGIN

        GetMouse(mouseLoc);
        LocalToGlobal(mouseLoc);            { ... apples with apples }
        mouseDH := mouseLoc.h - gMouse0.h;
        mouseDV := mouseLoc.v - gMouse0.v;
        IF mouseDH < 0 THEN                { Absolute values ... }
            mouseDH := -mouseDH;
        IF mouseDV < 0 THEN
            mouseDV := -mouseDV;
        ;
        sizeMove := mouseDV;
        sizeMove := BSL(sizeMove, 16);      { ... into High word. }
        sizeMove := sizeMove + mouseDH;     {  +  the low word.   }
        GetMouseMovement := sizeMove;

    END;   { GetMouseMovement }



{ ================================= }
{ Note that the algorithm I used    }
{ returns FALSE if we are dragging. }
{ ================================= }

    FUNCTION DoubleClick: BOOLEAN;

        VAR
            startTime, endTime, doubleTime: LONGINT;
            mouseLoc0: Point;
            sizeMove: Size;

    BEGIN   { DoubleClick }

        DoubleClick := FALSE;               { Assume Nada !! }
        doubleTime := GetDblTime;

        startTime := TickCount;             { Initialize time & mouse location. }
        endTime := startTime;
        GetMouse(mouseLoc0);
        LocalToGlobal(mouseLoc0);

        WHILE StillDown & ((endTime - startTime) <= doubleTime) DO   { First mouse click. }
            endTime := TickCount;             { Times out if dragging ... }

        sizeMove := GetMouseMovement(mouseLoc0);
        ;
        WHILE ((endTime - startTime) <= doubleTime) & (LoWord(sizeMove) <= 5) & (HiWord(sizeMove) <= 5) DO
        BEGIN
            IF Button THEN
            BEGIN
                DoubleClick := TRUE;            { Second time's a charm !! }
                Leave;
            END;   { IF Button }
            ;
            endTime := TickCount;
            sizeMove := GetMouseMovement(mouseLoc0);
        END;   { WHILE small delta Time AND small delta movement }

    END;   { DoubleClick }



    PROCEDURE DimRgn (rgn: RgnHandle);

        VAR
            pState: PenState;


    BEGIN

        GetPenState(pState);
        PenPat(gray);
        PenMode(patBic);
        PaintRgn(rgn);
        SetPenState(pState);

    END;   { DimRgn }



    FUNCTION Max (a, b: INTEGER): INTEGER;


    BEGIN
        IF a >= b THEN
            Max := a
        ELSE
            Max := b;
    END;   { Max }



    FUNCTION Min (a, b: INTEGER): INTEGER;


    BEGIN
        IF a <= b THEN
            Min := a
        ELSE
            Min := b;
    END;   { Min }



{ --------------------------------------------- }
{ This odd-ball is here to avoid circularity of }
{ USES between wBarMenuProc.p & wBMWindSubs.p   }
{ --------------------------------------------- }

    FUNCTION GetWindowPartColor (window: WindowPtr; part: INTEGER; VAR color: RGBColor): BOOLEAN;

        VAR
            auxWindowHdl: AuxWinHndl;
            windowCTab: CTabHandle;

    BEGIN

        GetWindowPartColor := FALSE;                             { Assume NADA !! }
        ;
        IF NOT aMac2 THEN
            EXIT(GetWindowPartColor);

        IF GetAuxWin(window, auxWindowHdl) THEN
        BEGIN
            windowCTab := auxWindowHdl^^.awCTable;
            IF (part < 0) | (part > windowCTab^^.ctSize) THEN     { Color me paranoid !! }
                EXIT(GetWindowPartColor);
            color := windowCTab^^.ctTable[part].rgb;
            GetWindowPartColor := TRUE;
        END;   { IF window has a AuxWinRec }

    END;   { GetWindowPartColor }



    PROCEDURE InitBigScreen (VAR RadStatus: RadiusData; VAR fontSize: INTEGER);

        CONST
            largeMenuBar = 5;                 { Bit # in CPFlags field for non-MacII. }
            RadInfoID = 0;

        VAR
            statusHdl, pivotHand: Handle;


    BEGIN

        SetResLoad(TRUE);

        pivotHand := GetNamedResource('INFO', 'Radius Pivot Display');
        IF pivotHand = NIL THEN
            LoadResource(pivotHand);
        RadStatus.PivotHdl := PivotDSHand(pivotHand);

        IF NOT aMac2 THEN
            statusHdl := GetNamedResource('INFO', 'Radius Display')
        ELSE
            statusHdl := GetNamedResource('INFO', 'Radius II Display');

        IF statusHdl = NIL THEN
        BEGIN
            LoadResource(statusHdl);
            IF statusHdl = NIL THEN          { Still !!! }
            BEGIN
                RadStatus.radType := none;
                fontSize := normalSize;
                EXIT(InitBigScreen);
            END;   { STILL! }
        END;   { Zip }

        IF NOT aMac2 THEN
        BEGIN
            IF BTST(RadBWStatHdl(statusHdl)^^.CPFlags, largeMenuBar) THEN
            BEGIN
                RadBWStatHdl(statusHdl)^^.LargeFontEn := chr(1);
                AddResource(statusHdl, 'INFO', RadInfoID, 'Radius Display');
                fontSize := chicago16;
      { ID = 128 * font number + size: }
                BIGfont := GetResource('FONT', 128 * systemFont + chicago16);
                IF BIGfont = NIL THEN
                    LoadResource(BIGfont);
                RadBWStatHdl(statusHdl)^^.LargeFontEn := chr(0);
                RadBWStatHdl(statusHdl)^^.PluggedIn := chr(0);
                AddResource(statusHdl, 'INFO', RadInfoID, 'Radius Display');
            END
            ELSE
                fontSize := normalSize;
            ;
            RadStatus.radType := radBW;
            RadStatus.BWHdl := RadBWStatHdl(statusHdl);
        END

        ELSE   { aMac2 }

        BEGIN
            IF ord(RadIIStatHdl(statusHdl)^^.LargeMenus) <> 0 THEN
            BEGIN
                fontSize := chicago16;
                BIGfont := GetResource('FONT', 128 * systemFont + chicago16);
                IF BIGfont = NIL THEN
                    LoadResource(BIGfont);
            END
            ELSE
                fontSize := normalSize;
            ;
            RadStatus.radType := radII;
            RadStatus.IIHdl := RadIIStatHdl(statusHdl);
        END;

    END;   { InitBigScreen }



    PROCEDURE myTextSize (size: INTEGER);

        CONST
            CurFMFamily = $988;
            FONDID = $BC6;

    BEGIN

        TextSize(size);
        wordPtr(CurFMFamily)^ := -1;     { Invalidate FM cache ... }
        wordPtr(FONDID)^ := -1;

    END;   { myTextSize }



    FUNCTION xPOWERy (x, y: INTEGER): extended;

    BEGIN
        xPOWERy := exp(y * ln(x));
    END;   { xPOWERy }




END.   { UNIT = wBMMiscSubs }